home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / nrpas13.zip / MMID.DEM < prev    next >
Text File  |  1991-04-29  |  1KB  |  65 lines
  1. PROGRAM d15r5(input,output);
  2. (* driver for routine MMID *)
  3. CONST
  4.    nvar=4;
  5.    x1=1.0;
  6.    htot=0.5;
  7. TYPE
  8.    glnarray = ARRAY [1..nvar] OF real;
  9. VAR
  10.    b1,b2,b3,b4,xf : real;
  11.    i,ii : integer;
  12.    y,yout,dydx : glnarray;
  13.  
  14. (*$I MODFILE.PAS *)
  15. (*$I BESSJ0.PAS *)
  16.  
  17. (*$I BESSJ1.PAS *)
  18.  
  19. (*$I BESSJ.PAS *)
  20.  
  21. PROCEDURE derivs(x: real; y: glnarray; VAR dydx: glnarray);
  22. (* Programs using DERIVS must define the type
  23. TYPE
  24.    glnarray = ARRAY [1..4] OF real;
  25. in the calling routine. *)
  26. BEGIN
  27.    dydx[1] := -y[2];
  28.    dydx[2] := y[1]-(1.0/x)*y[2];
  29.    dydx[3] := y[2]-(2.0/x)*y[3];
  30.    dydx[4] := y[3]-(3.0/x)*y[4]
  31. END;
  32.  
  33. (*$I MMID.PAS *)
  34.  
  35. BEGIN
  36.    y[1] := bessj0(x1);
  37.    y[2] := bessj1(x1);
  38.    y[3] := bessj(2,x1);
  39.    y[4] := bessj(3,x1);
  40.    dydx[1] := -y[2];
  41.    dydx[2] := y[1]-y[2];
  42.    dydx[3] := y[2]-2.0*y[3];
  43.    dydx[4] := y[3]-3.0*y[4];
  44.    xf := x1+htot;
  45.    b1 := bessj0(xf);
  46.    b2 := bessj1(xf);
  47.    b3 := bessj(2,xf);
  48.    b4 := bessj(3,xf);
  49.    writeln('First four Bessel functions:');
  50.    FOR ii := 1 to 10 DO BEGIN
  51.       i := 5*ii;
  52.       mmid(y,dydx,nvar,x1,htot,i,yout);
  53.       writeln;
  54.       writeln('x := ',x1:5:2,
  55.          ' to ',x1+htot:5:2,' in ',i:2,' steps');
  56.       writeln('integration':14,'bessj':9);
  57.       writeln(yout[1]:12:6,b1:12:6);
  58.       writeln(yout[2]:12:6,b2:12:6);
  59.       writeln(yout[3]:12:6,b3:12:6);
  60.       writeln(yout[4]:12:6,b4:12:6);
  61.       writeln('press return to continue...');
  62.       readln
  63.    END
  64. END.
  65.